home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / dos.swg / 0048_Disk Ready?.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  3.9 KB  |  121 lines
  1. {
  2.  some days ago, Bryan Ellis (gt6918b@prism.gatech.edu)
  3.  asked how one could, in TP, check whether a disk in a
  4.  drive is formatted or not. I did not see any answer on
  5.  this posted to the list, so here comes an 'extract' from
  6.  code of mine which might help.
  7.  
  8. { The following two procedures were extracted from old file
  9.  copy programs of mine; Therefore they should be 'cleaned-up'
  10.  and fixed up before being included in somebody's code.
  11.  The purpose of the first one is to ensure that:
  12.     a) the target disk (to be written to) is indeed
  13.  present in the drive;
  14.     b) the target disk is a formatted one. If it is
  15.  not, then opportunity is provided for formatting by
  16.  shelling to DOS (rather clumsy, but you get the idea ;-)).
  17.  
  18.   The purpose of the second procedure is partly redundant
  19.   with that of the first one. It checks whether the disk
  20.   is present in the drive, and it also warns when the disk
  21.   is write protected.
  22.   Calls to ancillary procedures for putting the cursor onto
  23.   the right column and row on the screen, or to clean up
  24.   the display, save and restore the screen, or warning noises
  25.   etc., were removed, which explains the somewhat desultory
  26.   code, which I had no time to rewrite :-( }
  27.  
  28.   { uses DOS,CRT; }
  29.  
  30. Procedure CheckDriv(driv : string; var OK:boolean;
  31.        var cc:char   );
  32. {* driv is the string holding the letter of the drive;        *}
  33. {* OK is a global boolean var which must be true in order for  *}
  34. {* the rest of the program to proceed.          *}
  35. {* cc : checks input by the user          *}
  36. {***************************************************************}
  37. var IOR    : integer;
  38.     jk,dr  : char;
  39.     S    : string;
  40.     CmdLine: PathStr;
  41. begin
  42.   OK  := TRUE;
  43.   IOR := 0;
  44. {$I-}
  45.   ChDir(driv);   { make the target drive current }
  46.   { the original current drive letter should be saved in order}
  47.   { to be restored afterwards }
  48.   dr := upcase(driv[1]);
  49.   IOR := IOresult;
  50.   if IOR = 152 then begin
  51.     OK := FALSE;
  52.     writeln('No disk in ',copy(driv,1,2));
  53.     writeln(' (Insert a disk or press ESC)');
  54.     repeat until keypressed;
  55.     cc := readkey
  56.   end
  57.   else
  58.   if IOR = 162 then begin
  59.     OK := FALSE;
  60.     writeln('Unformatted disk in ',copy(driv,1,2));
  61.     writeln('Press ESC to cancel...');
  62.     writeln('...or press ''*'' to format...');
  63.     repeat until keypressed;
  64.     cc := readkey;
  65.     { here, for security sake, only drives A and B were taken
  66.       into account for writing }
  67.     if ((cc = '*') AND ((dr = 'A') OR (dd = 'B'))) then
  68.       begin
  69.  cc := chr(27);
  70.  { now, your Format.com file had better be in the path! }
  71.  S := FSearch('FORMAT.COM', GetEnv('PATH'));
  72.  S := FExpand(S);
  73.  CmdLine := copy(driv,1,2);
  74.  SwapVectors;
  75.  Exec(S,CmdLine);
  76.  SwapVectors;
  77.  If DosError <> 0 then
  78.    write('Dos error #',DosError)
  79.  else
  80.    write('Press any key...');
  81.  repeat until keypressed;
  82.  jk := readkey;
  83.       end
  84.   end
  85. end;
  86. {$I+}
  87.  
  88. Procedure CheckWrite(var FF: file;
  89.        var OK: boolean;
  90.        var cc: char);
  91. {*   Tests for presence of disk in drive and write protect tab, *}
  92. {*   to allow opening of untyped file for write: this file has *}
  93. {*   of course been assigned before, elsewhere in the program *}
  94. {****************************************************************}
  95. {$I-}
  96. var riteprot : boolean;
  97.     DiskAbsent : boolean;
  98.     error : integer;
  99. begin
  100.   riteprot := TRUE;
  101.   DiskAbsent := TRUE;
  102.   rewrite(FF);
  103.   error := IOResult;
  104.   riteprot := error = 150;
  105.   DiskAbsent := error = 152;
  106.   if riteprot then begin
  107.     writeln('Disk is write protected!');
  108.     writeln('Correct the situation and press any key...');
  109.     repeat until keypressed;
  110.     cc := readkey
  111.   end;
  112.   if DiskAbsent then begin
  113.     writeln('No disk in the drive!');
  114.     writeln('Insert disk into drive, then press any key...');
  115.     repeat until keypressed;
  116.     cc := readkey
  117.   end;
  118.   OK := (Not(riteprot)) AND (Not(DiskAbsent))
  119. end;
  120. {$I+}
  121.